home *** CD-ROM | disk | FTP | other *** search
/ Programming Sound Cards / Programming Sound Cards.iso / sound_87 / stmloade.pas < prev    next >
Pascal/Delphi Source File  |  1995-01-01  |  10KB  |  387 lines
  1. UNIT StmLoader;
  2.  
  3. INTERFACE
  4.  
  5. USES Objects, SongUnit;
  6.  
  7.  
  8.  
  9.  
  10. PROCEDURE LoadStmFileFormat(VAR Song: TSong; VAR St: TStream; VAR Header: TSongHeader);
  11.  
  12.  
  13.  
  14.  
  15. IMPLEMENTATION
  16.  
  17. USES SongElements, SongUtils, Heaps, AsciiZ;
  18.  
  19.  
  20.  
  21.  
  22. {----------------------------------------------------------------------------}
  23. { Internal definitions. Format of the files.                                 }
  24. {____________________________________________________________________________}
  25.  
  26. TYPE
  27.   TStmFileMagic = ARRAY[1..8] OF CHAR;
  28.  
  29. CONST
  30.   MagicStm : TStmFileMagic = ( '!', 'S', 'c', 'r', 'e', 'a', 'm', '!' );
  31.  
  32. TYPE
  33.  
  34.   TStmInstrument =
  35.     RECORD
  36.       Name      : ARRAY[1..14] OF CHAR;
  37.       fill1     : WORD;
  38.       Size      : WORD;
  39.       RepStart  : WORD;
  40.       RepEnd    : WORD;
  41.       Volume    : WORD;
  42.       NAdj      : WORD;
  43.       fill2     : ARRAY[1..6] OF BYTE;
  44.     END;
  45.  
  46.   TStmHeader =
  47.     RECORD
  48.       Name        : ARRAY[1..20] OF CHAR;
  49.       Magic       : TStmFileMagic;
  50.       fill1       : LONGINT;
  51.       Tempo       : BYTE;
  52.       NPatterns   : BYTE;
  53.       Volume      : BYTE;
  54.       fill2       : ARRAY[1..13]  OF BYTE;
  55.       Instruments : ARRAY[1..31]  OF TStmInstrument;
  56.       Sequence    : ARRAY[1..128] OF BYTE;
  57.     END;
  58.  
  59.   TStmPattern = ARRAY[1..64, 1..4] OF
  60.     RECORD
  61.       b1, b2,
  62.       b3, b4 : BYTE;
  63.     END;
  64.  
  65.  
  66.  
  67.  
  68. PROCEDURE ProcessPatterns(VAR Song: TSong; VAR St: TStream; Num: WORD);
  69.   VAR
  70.     Patt      : TStmPattern;
  71.     FullTrack : TFullTrack;
  72.     Pattern   : PPattern;
  73.     Track     : PTrack;
  74.     c         : BYTE;
  75.     i, j      : WORD;
  76.     n, t      : WORD;
  77.     Row       : WORD;
  78.     Size      : WORD;
  79.     NAdj      : WORD;
  80.     Perd      : WORD;
  81.     l         : LONGINT;
  82.   BEGIN
  83.     t := 1;
  84.     FOR n := 1 TO Num DO
  85.       BEGIN
  86. {WriteLn('Patt ', n : 3, FullHeap.HMaxAvail : 10, FullHeap.HMemAvail : 10);}
  87.         Pattern := Song.GetPattern(n);
  88.         IF Pattern = NIL THEN
  89.           BEGIN
  90.             Song.Status := msOutOfMemory;
  91.             EXIT;
  92.           END;
  93.  
  94.         WITH Pattern^.Patt^ DO
  95.           BEGIN
  96.             NNotes := 64;
  97.             NChans := Song.NumChannels;
  98.             Tempo  := 0;
  99.             BPM    := 0;
  100.           END;
  101.  
  102.         St.Read(Patt, SizeOf(Patt));
  103.  
  104.         IF St.Status <> stOk THEN
  105.           BEGIN
  106.             Song.Status := msFileTooShort;
  107.             EXIT;
  108.           END;
  109.  
  110.         FOR j := 1 TO Song.NumChannels DO
  111.           BEGIN
  112.             FillChar(FullTrack, SizeOf(FullTrack), 0);
  113.  
  114.             FOR i := 1 TO 64 DO
  115.               WITH FullTrack[i-1], Patt[i][j] DO
  116.                 BEGIN
  117.                   FillChar(FullTrack[i-1], SizeOf(FullTrack[0]), 0);
  118.  
  119.                   IF b1 <> $FF THEN
  120.                     BEGIN
  121.                       Period := b1;
  122.                       IF ((Period AND $F0) > $70) OR
  123.                          ((Period AND $F0) < $00) OR
  124.                          ((Period AND $0F) > $0B) THEN
  125.                         Period := 0;
  126.                       Instrument := b2 SHR 3;
  127.                     END;
  128.  
  129.                   Volume := ((b3 AND $F0) SHR 1) + (b2 AND $07);
  130.  
  131.                   IF Volume > 64 THEN
  132.                     Volume := 0
  133.                   ELSE IF Volume < 64 THEN
  134.                     INC(Volume);
  135.  
  136.                   Parameter := b4;
  137.                   CASE b3 AND $F OF
  138.                      0 : Command := mcNone;
  139.                      1 : BEGIN
  140.                            Command   := mcSetTempo;
  141.                            Parameter := b4 SHR 4;
  142.                          END;
  143.                      2 : BEGIN
  144.                            Command := mcJumpPattern;
  145.                            INC(Parameter);
  146.                          END;
  147.                      3 : Command := mcEndPattern;
  148.                      4 : Command := mcVolSlide;
  149.                      5 : Command := mcTPortDown;
  150.                      6 : Command := mcTPortUp;
  151.                      7 : Command := mcNPortamento;
  152.                      8 : Command := mcVibrato;
  153.                     10 : Command := mcArpeggio;
  154.                   ELSE
  155.                     Command := TModCommand(ORD(mcLast) + (b3 AND $F));
  156.                   END;
  157.  
  158.                   IF ((Command = mcEndPattern) OR (Command = mcJumpPattern)) AND
  159.                      (Pattern^.Patt^.NNotes > i) THEN
  160.                     Pattern^.Patt^.NNotes := i;
  161.  
  162.                   IF Period <> 0 THEN
  163.                     BEGIN
  164. {
  165.                       IF (Song.GetInstrument(Instrument)        = NIL) OR
  166.                          (Song.GetInstrument(Instrument)^.Instr = NIL) THEN
  167.                         Dadj := NAdj
  168.                       ELSE
  169.                         DAdj := Song.GetInstrument(Instrument)^.Instr^.DAdj;
  170. }
  171.                       Perd := PeriodSet[(Period SHR 4), Period AND 15];
  172. {
  173.                       IF DAdj > $3E7 THEN
  174.                         ASM
  175.                           MOV     AX,Perd
  176.                           MOV     BX,$20AB
  177.                           MUL     BX
  178.                           MOV     BX,DAdj
  179.                           DIV     BX
  180.                           MOV     Perd,AX
  181.                         END;
  182. }
  183.                       Period := Perd;
  184.                     END;
  185.                 END;
  186.  
  187.             Track := Song.GetTrack(t);
  188.             IF Track = NIL THEN
  189.               BEGIN
  190.                 Song.Status := msOutOfMemory;
  191.                 EXIT;
  192.               END;
  193.  
  194.             Track^.SetFullTrack(FullTrack);
  195.  
  196.             Pattern^.Patt^.Channels[j] := t;
  197.  
  198.             INC(t);
  199.           END;
  200.  
  201.       END;
  202.   END;
  203.  
  204.  
  205. PROCEDURE ProcessInstruments(VAR Song: TSong; VAR St: TStream; VAR Hdr: TStmHeader);
  206.   VAR
  207.     Instrument : TInstrumentRec;
  208.     Instr      : PInstrument;
  209.     i, w       : WORD;
  210.     Signo      : LONGINT;
  211.     NoSigno    : LONGINT;
  212.   BEGIN
  213.     FOR i := 1 TO 31 DO
  214.       WITH Instrument DO
  215.         BEGIN
  216.           FillChar(Instrument, SizeOf(Instrument), 0);
  217.  
  218.           Instr := Song.GetInstrument(i);
  219.           IF Instr = NIL THEN
  220.             BEGIN
  221.               Song.Status := msOutOfMemory;
  222.               EXIT;
  223.             END;
  224.  
  225.           Instr^.SetName(StrASCIIZ(Hdr.Instruments[i].Name, 14));
  226.  
  227.           Len  := Hdr.Instruments[i].Size;
  228.  
  229.           IF Len > 0 THEN
  230.             BEGIN
  231.  
  232.               IF (Hdr.Instruments[i].RepStart <>     0) OR
  233.                  (Hdr.Instruments[i].RepEnd   <> 65535) THEN
  234.                 BEGIN
  235.                   Reps := Hdr.Instruments[i].RepStart;
  236.                   Repl := Hdr.Instruments[i].RepEnd - Reps;
  237.                 END
  238.               ELSE
  239.                 BEGIN
  240.                   Reps := 0;
  241.                   Repl := 0;
  242.                 END;
  243.  
  244.               Vol  := Hdr.Instruments[i].Volume;
  245.               Dadj := Hdr.Instruments[i].Nadj;
  246.               NAdj := $2100;
  247.  
  248.               IF Vol > $40 THEN
  249.                 Vol := $40;
  250.  
  251.               IF Repl        > Len THEN Repl := Len;
  252.               IF Reps + Repl > Len THEN Repl := Len - Reps;
  253.  
  254.               Instr^.Change(@Instrument);
  255.             END
  256.           ELSE
  257.             Instr^.Change(NIL);
  258.         END;
  259.   END;
  260.  
  261.  
  262.  
  263. PROCEDURE ProcessSamples(VAR Song: TSong; VAR St: TStream);
  264.   VAR
  265.     Instr      : PInstrument;
  266.     i, w       : WORD;
  267.   BEGIN
  268.     FOR i := 1 TO 31 DO
  269.       BEGIN
  270. {WriteLn('Instr ', i : 3, FullHeap.HMaxAvail : 10, FullHeap.HMemAvail : 10);}
  271.         Instr := Song.GetInstrument(i);
  272.  
  273.         IF (Instr^.Instr     <> NIL) AND
  274.            (Instr^.Instr^.Len > 0)   THEN
  275.           WITH Instr^.Instr^ DO
  276.             BEGIN
  277.               IF Len <= MaxSample THEN
  278.                 BEGIN
  279.                   FullHeap.HGetMem(POINTER(Data), Len);
  280.                   IF Data = NIL THEN BEGIN
  281.                     Song.Status := msOutOfMemory;
  282.                     EXIT;
  283.                   END;
  284.  
  285.                   St.Read(Data^, Len);
  286.  
  287.                   IF St.Status <> stOk THEN BEGIN
  288.                     Song.Status := msFileDamaged;
  289.                     EXIT;
  290.                   END;
  291. {
  292.                   FOR w := 0 TO Len - 1 DO
  293.                     INC(Data^[w], 128);
  294. }
  295.                 END
  296.               ELSE
  297.                 BEGIN
  298.                   FullHeap.HGetMem(POINTER(Data), MaxSample);
  299.                   FullHeap.HGetMem(POINTER(Xtra), Len-MaxSample);
  300.  
  301.                   IF (Data = NIL) OR (Xtra = NIL) THEN BEGIN
  302.                     Song.Status := msOutOfMemory;
  303.                     EXIT;
  304.                   END;
  305.  
  306.                   St.Read(Data^, MaxSample);
  307.                   St.Read(Xtra^, Len-MaxSample);
  308.  
  309.                   IF St.Status <> 0 THEN BEGIN
  310.                     Song.Status := msFileDamaged;
  311.                     EXIT;
  312.                   END;
  313.                 END;
  314.             END;
  315.  
  316.         IF LowQuality THEN
  317.           Instr^.Desample;
  318.  
  319.       END;
  320.   END;
  321.  
  322. PROCEDURE LoadStmFileFormat(VAR Song: TSong; VAR St: TStream; VAR Header: TSongHeader);
  323.   VAR
  324.     Hdr        : TStmHeader ABSOLUTE Header;
  325.     InitialPos : LONGINT;
  326.     i          : WORD;
  327.   BEGIN
  328.     Song.FileFormat := mffStm;
  329.  
  330.     InitialPos := St.GetPos;
  331.  
  332.     St.Seek(InitialPos + SizeOf(TStmHeader));
  333.  
  334.     IF Hdr.Magic <> MagicStm THEN
  335.       BEGIN
  336.         Song.Status := msNotLoaded;
  337.         EXIT;
  338.       END;
  339.  
  340.     Song.Status := msOK;
  341.  
  342.     Song.Name := FullHeap.HNewStr(StrAsciiZ(Hdr.Name, 20));
  343.  
  344.     IF Hdr.Volume = 64 THEN
  345.       Hdr.Volume := 63;
  346.  
  347.     Song.FirstTick    := TRUE;
  348.     Song.InitialTempo := Hdr.Tempo SHR 4;
  349.     Song.InitialBPM   := 125;
  350.     Song.Volume       := Hdr.Volume SHL 2;
  351.     Song.NumChannels  := 4;
  352.  
  353.     Song.SequenceLength := 0;
  354.     FOR i := 1 TO 128 DO
  355.       IF Hdr.Sequence[i] < 99 THEN
  356.         Song.SequenceLength := i;
  357.  
  358.     Song.SequenceRepStart := 1;
  359.     Move(Hdr.Sequence, Song.PatternSequence^, Song.SequenceLength);
  360.  
  361.     FOR i := 1 TO Song.SequenceLength DO
  362.       INC(Song.PatternSequence^[i]);
  363.  
  364.  
  365.     { Processing of the instruments }
  366.  
  367.     ProcessInstruments(Song, St, Hdr);
  368.     IF Song.Status > msOk THEN EXIT;
  369.  
  370.  
  371.     { Processing of the patterns (the partiture) }
  372.  
  373.     ProcessPatterns(Song, St, Hdr.NPatterns);
  374.     IF Song.Status > msOk THEN EXIT;
  375.  
  376.  
  377.     { Processing of the samples }
  378.  
  379.     ProcessSamples(Song, St);
  380.     IF Song.Status > msFileTooShort THEN EXIT;
  381.   END;
  382.  
  383.  
  384.  
  385.  
  386. END.
  387.